home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / system-tools-backends-2.0 / scripts / Utils / Replace.pm < prev    next >
Encoding:
Perl POD Document  |  2009-04-09  |  31.4 KB  |  1,378 lines
  1. #-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-
  2.  
  3. # replace.pl: Common in-line replacing stuff for the ximian-setup-tools backends.
  4. #
  5. # Copyright (C) 2000-2001 Ximian, Inc.
  6. #
  7. # Authors: Hans Petter Jansson <hpj@ximian.com>
  8. #          Arturo Espinosa <arturo@ximian.com>
  9. #          Michael Vogt <mvo@debian.org> - Debian 2.[2|3] support.
  10. #          David Lee Ludwig <davidl@wpi.edu> - Debian 2.[2|3] support.
  11. #
  12. # This program is free software; you can redistribute it and/or modify
  13. # it under the terms of the GNU Library General Public License as published
  14. # by the Free Software Foundation; either version 2 of the License, or
  15. # (at your option) any later version.
  16. #
  17. # This program is distributed in the hope that it will be useful,
  18. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. # GNU Library General Public License for more details.
  21. #
  22. # You should have received a copy of the GNU Library General Public License
  23. # along with this program; if not, write to the Free Software
  24. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  25.  
  26. package Utils::Replace;
  27.  
  28. use Utils::Util;
  29. use Utils::File;
  30. use Utils::Parse;
  31.  
  32.  
  33. # General rules: all replacing is in-line. Respect unsupported values, comments
  34. # and as many spacing as possible.
  35.  
  36. # The concept of keyword (kw) here is a key, normaly in its own line, whose
  37. # boolean representation is its own existence.
  38.  
  39. # A $re is a regular expression. In most functions here, regular expressions
  40. # are converted to simple separators, by using gst_replace_regexp_to_separator.
  41. # This makes it easier to convert a parse table into a replace table.
  42.  
  43. # Every final replacing function to be used by a table must handle one key
  44. # at a time, but may replace several values from there.
  45. #
  46. # Return 0 for success, and -1 for failure.
  47. #
  48. # Most of these functions have a parsing counterpart. The convention is
  49. # that parse becomes replace and split becomes join:
  50. # split_first_str -> join_first_str
  51.  
  52. # Additional abstraction: replace table entries can have
  53. # arrays inside. The replace proc will be ran with every
  54. # combination that the arrays provide. Ex:
  55. # ["user", \&gst_replace_foo, [0, 1], [2, 3] ] will replace
  56. # using all possibilities in the combinatory of [0, 1]x[2, 3].
  57. # Check RedHat 7.2's network replace table for further
  58. # enlightenment.
  59. sub run_entry
  60. {
  61.   my ($values_hash, $key, $proc, $cp, $value) = @_;
  62.   my ($ncp, $i, $j, $res);
  63.  
  64.   $ncp = [@$cp];
  65.   for ($i = 0; $i < scalar (@$cp); $i ++)
  66.   {
  67.       if (ref $$cp[$i] eq "ARRAY")
  68.       {
  69.           foreach $j (@{$$cp[$i]})
  70.           {
  71.               $$ncp[$i] = $j;
  72.               $res = -1 if &run_entry ($values_hash, $key, $proc, $ncp, $value);
  73.           }
  74.           return $res;
  75.       }
  76.   }
  77.   
  78.   # OK, the given entry didn't have any array refs in it...
  79.  
  80.   return -1 if (!&Utils::Parse::replace_hash_values ($ncp, $values_hash));
  81.   push (@$ncp, $$values_hash{$key}) unless $key eq "_always_";
  82.   $res = -1 if &$proc (@$ncp);
  83.   return $res;
  84. }
  85.  
  86. # gst_replace_from_table takes a file mapping, a replace table, a hash
  87. # of values, probably made from XML parsing, and whose keys are
  88. # the same keys the table handles.
  89. #
  90. # Table entries whose keys are not present in the values_hash
  91. # will not be processed. More than one entry may process the same key.
  92. #
  93. # The functions in the replace tables, most of which are coded in
  94. # this file, receive the mapped files of the first argument, and then
  95. # a set of values. The last argument is the value of the $values_hash
  96. # for the corresponding key of the entry.
  97. sub set_from_table
  98. {
  99.   my ($fn, $table, $values_hash, $old_hash) = @_;
  100.   my ($key, $proc, @param);
  101.   my ($i, @cp, @files, $res);
  102.  
  103.   $$fn{"OLD_HASH"} = $old_hash;
  104.  
  105.   foreach $i (@$table)
  106.   {
  107.     @cp = @$i;
  108.     $key = shift (@cp);
  109.  
  110.     $proc = shift (@cp);
  111.     @files = &Utils::Parse::replace_files (shift (@cp), $fn);
  112.     unshift @cp, @files if (scalar @files) > 0;
  113.  
  114.     # treat empty values as undef
  115.     delete $$values_hash{$key} if ($$values_hash{$key} eq "");
  116.  
  117.     if ((exists $$values_hash{$key}) or ($key eq "_always_"))
  118.     {
  119.       $res = &run_entry ($values_hash, $key, $proc, \@cp, $$values_hash{$key});
  120.     }
  121.     elsif ((!exists $$values_hash{$key}) && (exists $$old_hash{$key}))
  122.     {
  123.       # we need to remove all the instances of the known variables that doesn't exist in the data structure
  124.       $res = &run_entry ($values_hash, $key, $proc, \@cp, undef);
  125.     }
  126.   }
  127.  
  128.   return $res;
  129. }
  130.  
  131. # Wacky function that tries to create a field separator from a regular expression.
  132. # Doesn't work with all possible regular expressions: just with the ones we are working with.
  133. sub regexp_to_separator
  134. {
  135.   $_ = $_[0];
  136.  
  137.   s/\[([^^])([^\]])[^\]]*\]/$1/g;
  138.   s/\+//g;
  139.   s/\$//g;
  140.   s/[^\*]\*//g;
  141.  
  142.   return $_;
  143. }
  144.  
  145. sub set_value
  146. {
  147.   my ($key, $val, $re) = @_;
  148.   
  149.   return $key . ®exp_to_separator ($re) . $val;
  150. }
  151.  
  152. # Edit a $file, wich is assumed to have a column-based format, with $re matching field separators
  153. # and one record per line. Search for lines with the corresponding $key.
  154. # The last arguments can be any number of standard strings.
  155. sub split
  156. {
  157.   my ($file, $key, $re, @value) = @_;
  158.   my ($fd, @line, @res);
  159.   my ($buff, $i);
  160.   my ($pre_space, $post_comment);
  161.   my ($line_key, $val, $ret);
  162.  
  163.   &Utils::Report::enter ();
  164.   &Utils::Report::do_report ("replace_split", $key, $file);
  165.  
  166.   $buff = &Utils::File::load_buffer ($file);
  167.   
  168.   foreach $i (@$buff)
  169.   {
  170.     $pre_space = $post_comment = "";
  171.  
  172.     chomp $i;
  173.     $pre_space    = $1 if $i =~ s/^([ \t]+)//;
  174.     $post_comment = $1 if $i =~ s/([ \t]*\#.*)//;
  175.     
  176.     if ($i ne "")
  177.     {
  178.       @line = split (/($re)/, $i, 2);
  179.       $line_key = shift (@line);
  180.       $spacing = shift (@line);
  181.  
  182.       # found the key?
  183.       if ($line_key eq $key)
  184.       {
  185.         shift (@value) while ($value[0] eq "" && (scalar @value) > 0);
  186.  
  187.         if ((scalar @value) == 0)
  188.         {
  189.           $i = "";
  190.           next;
  191.         }
  192.  
  193.         $val = shift (@value);
  194.  
  195.         chomp $val;
  196.         $i = $key . $spacing . $val;
  197.       }
  198.     }
  199.  
  200.     $i = $pre_space . $i . $post_comment . "\n";
  201.   }
  202.  
  203.   foreach $i (@value)
  204.   {
  205.     push (@$buff, &set_value ($key, $i, $re) . "\n") if ($i ne "");
  206.   }
  207.  
  208.   &Utils::File::clean_buffer ($buff);
  209.   $ret = &Utils::File::save_buffer ($buff, $file);
  210.   &Utils::Report::leave ();
  211.   return $ret;
  212. }
  213.  
  214. # Replace all key/values in file with those in @$value,
  215. # deleting exceeding ones and appending those required.
  216. sub join_all
  217. {
  218.   my ($file, $key, $re, $value) = @_;
  219.  
  220.   return &split ($file, $key, $re, @$value);
  221. }
  222.  
  223. # Find first $key value and replace with $value. Append if not found.
  224. sub join_first_str
  225. {
  226.   my ($file, $key, $re, $value) = @_;
  227.  
  228.   return &split ($file, $key, $re, $value);
  229. }
  230.  
  231. # Treat value as a bool value, using val_off and val_on as corresponding
  232. # boolean representations.
  233. sub join_first_bool
  234. {
  235.   my ($file, $key, $re, $val_on, $val_off, $value) = @_;
  236.  
  237.   # Fixme: on and off should be a parameter.
  238.   $value = ($value == 1)? $val_on: $val_off;
  239.   
  240.   return &split ($file, $key, $re, $value);
  241. }
  242.  
  243. # Find first key in file, and set array join as value.
  244. sub join_first_array
  245. {
  246.   my ($file, $key, $re1, $re2, $value) = @_;
  247.  
  248.   return &split ($file, $key, $re1, join (®exp_to_separator ($re2), @$value));
  249. }
  250.  
  251. # Escape $value in /bin/sh way, find/append key and set escaped value.
  252. sub set_sh
  253. {
  254.   my ($file, $key, $value, $unescaped) = @_;
  255.   my $ret;
  256.  
  257.   $value = &Utils::Parse::escape ($value) unless $unescaped;
  258.  
  259.   &Utils::Report::enter ();
  260.   &Utils::Report::do_report ("replace_sh", $key, $file);
  261.  
  262.   # This will expunge the whole var if the value is empty.
  263.   if ($value eq "")
  264.   {
  265.     $ret = &split ($file, $key, "[ \t]*=[ \t]*");
  266.   }
  267.   else
  268.   {
  269.     $ret = &split ($file, $key, "[ \t]*=[ \t]*", $value);
  270.   }
  271.   
  272.   &Utils::Report::leave ();
  273.   return $ret;
  274. }
  275.  
  276. # Escape $value in /bin/sh way, find/append key and set escaped value, make sure line har 
  277. sub set_sh_export
  278. {
  279.   my ($file, $key, $value) = @_;
  280.   my $ret;
  281.  
  282.   $value = &Utils::Parse::escape ($value);
  283.  
  284.   # This will expunge the whole var if the value is empty.
  285.  
  286.   # FIXME: Just adding "export " works for the case I need, though it doesn't
  287.   # handle arbitraty whitespace. Something should be written to replace split()
  288.   # here.
  289.  
  290.   if ($value eq "")
  291.   {
  292.     $ret = &split ($file, "export " . $key, "[ \t]*=[ \t]*");
  293.   }
  294.   else
  295.   {
  296.     $ret = &split ($file, "export " . $key, "[ \t]*=[ \t]*", $value);
  297.   }
  298.   
  299.   return $ret;
  300. }
  301.  
  302. # Treat value as a yes/no bool, replace in shell style.
  303. # val_true and val_false have default yes/no values.
  304. # use &set_sh_bool (file, key, value) if defaults are desired.
  305. sub set_sh_bool
  306. {
  307.   my ($file, $key, $val_true, $val_false, $value) = @_;
  308.  
  309.   # default value magic.
  310.   if ($val_false eq undef)
  311.   {
  312.       $value = $val_true;
  313.       $val_true = undef;
  314.   }
  315.  
  316.   $val_true  = "yes" unless $val_true;
  317.   $val_false = "no"  unless $val_false;
  318.  
  319.   $value = ($value == 1)? $val_true: $val_false;
  320.   
  321.   return &set_sh ($file, $key, $value);
  322. }
  323.  
  324. # Treat value as a yes/no bool, replace in export... shell style.
  325. sub set_sh_export_bool
  326. {
  327.   my ($file, $key, $val_true, $val_false, $value) = @_;
  328.  
  329.   # default value magic.
  330.   if ($val_false eq undef)
  331.   {
  332.       $value = $val_true;
  333.       $val_true = undef;
  334.   }
  335.  
  336.   $val_true  = "yes" unless $val_true;
  337.   $val_false = "no"  unless $val_false;
  338.  
  339.   $value = ($value == 1)? $val_true: $val_false;
  340.   
  341.   return &set_sh_export ($file, $key, $value);
  342. }
  343.  
  344. # Get a fully qualified hostname from a $key shell var in $file
  345. # and set the hostname part. e.g.: suse70's /etc/rc.config's FQHOSTNAME.
  346. sub set_hostname
  347. {
  348.   my ($file, $key, $value) = @_;
  349.   my ($domain);
  350.  
  351.   $domain = &Utils::Parse::get_sh_domain ($file, $key);
  352.   return &set_sh ($file, $key, "$value.$domain");
  353. }
  354.  
  355. # Get a fully qualified hostname from a $key shell var in $file
  356. # and set the domain part. e.g.: suse70's /etc/rc.config's FQHOSTNAME.
  357. sub set_domain
  358. {
  359.   my ($file, $key, $value) = @_;
  360.   my ($hostname);
  361.  
  362.   $hostname = &Utils::Parse::get_sh_hostname ($file, $key);
  363.   return &set_sh ($file, $key, "$hostname.$value");
  364. }
  365.  
  366. # Join the array pointed by $value with the corresponding $re separator
  367. # and assign that to the $key shell variable in $file.
  368. sub set_sh_join
  369. {
  370.   my ($file, $key, $re, $value) = @_;
  371.  
  372.   return &set_sh ($file, $key,
  373.                           join (®exp_to_separator ($re), @$value));
  374. }
  375.  
  376. # replace a regexp with $value
  377. sub set_sh_re
  378. {
  379.   my ($file, $key, $re, $value) = @_;
  380.   my ($val);
  381.  
  382.   $val = &Utils::Parse::get_sh ($file, $key);
  383.  
  384.   if ($val =~ /$re/)
  385.   {
  386.     $val =~ s/$re/$value/;
  387.   }
  388.   else
  389.   {
  390.     $val .= $value;
  391.   }
  392.  
  393.   $val = '"' . $val . '"' if ($val !~ /^\".*\"$/);
  394.  
  395.   return &split ($file, $key, "[ \t]*=[ \t]*", $val)
  396. }
  397.  
  398. # Quick trick to set a keyword $key in $file. (think /etc/lilo.conf keywords).
  399. sub set_kw
  400. {
  401.   my ($file, $key, $value) = @_;
  402.   my $ret;
  403.  
  404.   &Utils::Report::enter ();
  405.   &Utils::Report::do_report ("replace_kw", $key, $file);
  406.   $ret = &split ($file, $key, "\$", ($value)? "\n" : "");
  407.   &Utils::Report::leave ();
  408.   return $ret;
  409. }
  410.  
  411. # The kind of $file whose $value is its first line contents.
  412. # (/etc/hostname)
  413. sub set_first_line
  414. {
  415.   my ($file, $value) = @_;
  416.   my $fd;
  417.  
  418.   &Utils::Report::enter ();
  419.   &Utils::Report::do_report ("replace_line_first", $file);
  420.   $fd = &Utils::File::open_write_from_names ($file);
  421.   &Utils::Report::leave ();
  422.   return -1 if !$fd;
  423.  
  424.   print $fd "$value\n";
  425.   &Utils::File::close_file ($fd);
  426.   
  427.   return 0;
  428. }
  429.  
  430. # For every key in %$value, replace/append the corresponding key/value pair.
  431. # The separator for $re1 
  432. sub join_hash
  433. {
  434.   my ($file, $re1, $re2, $value) = @_;
  435.   my ($i, $res, $tmp, $val);
  436.   my ($oldhash, %merge);
  437.  
  438.   $oldhash = &Utils::Parse::split_hash ($file, $re1, $re2);
  439.   foreach $i (keys (%$value), keys (%$oldhash))
  440.   {
  441.     $merge{$i} = 1;
  442.   }
  443.  
  444.   $res = 0;
  445.   
  446.   foreach $i (keys (%merge))
  447.   {
  448.     if (exists $$value{$i})
  449.     {
  450.       $val = join (®exp_to_separator ($re2), @{$$value{$i}});
  451.       $tmp = &split ($file, $i, $re1, $val);
  452.     }
  453.     else
  454.     {
  455.       # This deletes the entry.
  456.       $tmp = &split ($file, $i, $re1);
  457.     }
  458.     $res = $tmp if !$res;
  459.   }
  460.  
  461.   return $res;
  462. }
  463.  
  464. # Find $re matching send string and replace parenthesyzed
  465. # part of $re with $value. FIXME: apply meeks' more general impl.
  466. sub set_chat
  467. {
  468.   my ($file, $re, $value) = @_;
  469.   my ($buff, $i, $bak, $found, $substr, $ret);
  470.  
  471.   &Utils::Report::enter ();
  472.   &Utils::Report::do_report ("replace_chat", $file);
  473.   $buff = &Utils::File::load_buffer ($file);
  474.  
  475.   SCAN: foreach $i (@$buff)
  476.   {
  477.     $bak = "";
  478.     $found = "";
  479.     my ($quoted);
  480.     chomp $i;
  481.  
  482.     while ($i ne "")
  483.     {
  484.      $i =~ s/^\s*//;
  485.  
  486.      # If it uses quotes. FIXME: Assuming they surround the whole string.
  487.      if ($i =~ /^\'/)
  488.      {
  489.        $i =~ s/\'([^\']*)\' ?//;
  490.        $found = $1;
  491.        $quoted = 1;
  492.      }
  493.      else
  494.      {
  495.        $i =~ s/([^ \t]*) ?//;
  496.        $found = $1;
  497.        $quoted = 0;
  498.      }
  499.  
  500.      # If it looks like what we're looking for,
  501.      # substitute what is in parens with value.
  502.      if ($found =~ /$re/i)
  503.      {
  504.        $substr = $1;
  505.        $substr =~ s/\*/\\\*/g;
  506.        $found =~ s/$substr/$value/i;
  507.  
  508.        if ($quoted == 1)
  509.        {
  510.          $i = $bak . "\'$found\' " . $i . "\n";
  511.        }
  512.        else
  513.        {
  514.          $i = $bak . "$found " . $i . "\n";
  515.        }
  516.  
  517.        last SCAN;
  518.      }
  519.  
  520.      if ($quoted == 1)
  521.      {
  522.        $bak .= "\'$found\'";
  523.      }
  524.      else
  525.      {
  526.        $bak .= "$found";
  527.      }
  528.  
  529.      $bak .= " " if $bak ne "";
  530.     }
  531.     
  532.     $i = $bak . "\n";
  533.   }
  534.  
  535.   $ret = &Utils::File::save_buffer ($buff, $file);
  536.   &Utils::Report::leave ();
  537.   return $ret;
  538. }
  539.  
  540. # Find/append $section in ini $file and replace/append
  541. # $var = $value pair. FIXME: should reimplement with
  542. # interfaces style. This is too large.
  543. sub set_ini
  544. {
  545.   my ($file, $section, $var, $value) = @_;
  546.   my ($buff, $i, $found_flag, $ret);
  547.   my ($pre_space, $post_comment, $sec_save);
  548.   my ($escaped_section);
  549.  
  550.   &Utils::Report::enter ();
  551.   &Utils::Report::do_report ("replace_ini", $var, $section, $file);
  552.  
  553.   $buff = &Utils::File::load_buffer ($file);
  554.  
  555.   &Utils::File::join_buffer_lines ($buff);
  556.   $found_flag = 0;
  557.   $escaped_section = Utils::Parse::escape ($section);
  558.   
  559.   foreach $i (@$buff)
  560.   {
  561.     $pre_space = $post_comment = "";
  562.     
  563.     chomp $i;
  564.     $pre_space = $1 if $i =~ s/^([ \t]+)//;
  565.     $post_comment = $1 if $i =~ s/([ \t]*[\#;].*)//;
  566.     
  567.     if ($i ne "")
  568.     {
  569.       if ($i =~ /\[$escaped_section\]/i)
  570.       {
  571.         $i =~ s/(\[$escaped_section\][ \t]*)//i;
  572.         $sec_save = $1;
  573.         $found_flag = 1;
  574.       }
  575.  
  576.       if ($found_flag)
  577.       {
  578.         if ($i =~ /\[[^\]]+\]/)
  579.         {
  580.           $i = "$var = $value\n$i" if ($value ne "");
  581.           $found_flag = 2;
  582.         }
  583.  
  584.         if ($i =~ /^$var[ \t]*=/i)
  585.         {
  586.           if ($value ne "")
  587.           {
  588.             $i =~ s/^($var[ \t]*=[ \t]*).*/$1$value/i;
  589.           }
  590.           else
  591.           {
  592.             $i = "";
  593.           }
  594.           $found_flag = 2;
  595.         }
  596.       }
  597.     }
  598.     
  599.     if ($found_flag && $sec_save ne "")
  600.     {
  601.       $i = $sec_save . $i;
  602.       $sec_save = "";
  603.     }
  604.     
  605.     $i = $pre_space . $i . $post_comment . "\n";
  606.     last if $found_flag == 2;
  607.   }
  608.  
  609.   push @$buff, "\n[$section]\n" if (!$found_flag);
  610.   push @$buff, "$var = $value\n" if ($found_flag < 2 && $value ne "");
  611.  
  612.   &Utils::File::clean_buffer ($buff);
  613.   $ret = &Utils::File::save_buffer ($buff, $file);
  614.   &Utils::Report::leave ();
  615.   return $ret;
  616. }
  617.  
  618. # Well, removes a $section from an ini type $file.
  619. sub remove_ini_section
  620. {
  621.   my ($file, $section) = @_;
  622.   my ($buff, $i, $found_flag, $ret);
  623.   my ($pre_space, $post_comment, $sec_save);
  624.   my ($escaped_section);
  625.  
  626.   &Utils::Report::enter ();
  627.   &Utils::Report::do_report ("replace_del_ini_sect", $section, $file);
  628.  
  629.   $buff = &Utils::File::load_buffer ($file);
  630.   $escaped_section = &Utils::Parse::escape ($section);
  631.  
  632.   &Utils::File::join_buffer_lines ($buff);
  633.   $found_flag = 0;
  634.  
  635.   foreach $i (@$buff)
  636.   {
  637.     $pre_space = $post_comment = "";
  638.  
  639.     chomp $i;
  640.     $pre_space = $1 if $i =~ s/^([ \t]+)//;
  641.     $post_comment = $1 if $i =~ s/([ \t]*[\#;].*)//;
  642.     
  643.     if ($i ne "")
  644.     {
  645.       if ($i =~ /\[$escaped_section\]/i)
  646.       {
  647.         $i =~ s/(\[$escaped_section\][ \t]*)//i;
  648.         $found_flag = 1;
  649.       }
  650.       elsif ($found_flag && $i =~ /\[.+\]/i)
  651.       {
  652.         $i = $pre_space . $i . $post_comment . "\n";
  653.         last;
  654.       }
  655.     }
  656.  
  657.     if ($found_flag)
  658.     {
  659.       if ($post_comment =~ /^[ \t]*$/)
  660.       {
  661.         $i = "";
  662.       }
  663.       else
  664.       {
  665.         $i = $post_comment . "\n";
  666.       }
  667.     }
  668.     else
  669.     {
  670.       $i = $pre_space . $i . $post_comment . "\n";
  671.     }
  672.   }
  673.  
  674.   &Utils::File::clean_buffer ($buff);
  675.   $ret = &Utils::File::save_buffer ($buff, $file);
  676.   &Utils::Report::leave ();
  677.   return $ret;
  678. }
  679.  
  680. # Removes a $var in $section of a ini type $file.
  681. sub remove_ini_var
  682. {
  683.   my ($file, $section, $var) = @_;
  684.   &set_ini ($file, $section, $var, "");
  685. }
  686.  
  687. # Replace using boolean $value with a yes/no representation,
  688. # ini style.
  689. sub set_ini_bool
  690. {
  691.   my ($file, $section, $var, $value) = @_;
  692.  
  693.   $value = ($value == 0)? "no": "yes";
  694.  
  695.   return &set_ini ($file, $section, $var, $value);
  696. }
  697.  
  698.  
  699. # Debian /etc/network/interfaces in-line replacing methods.
  700.  
  701. # From loaded buffer, starting at $line_no, find next debian
  702. # interfaces format stanza. Return array ref with all stanza args.
  703. # -1 if not found.
  704. # NOTE: $line_no is a scalar ref. and gives the position of next stanza.
  705. sub interfaces_get_next_stanza
  706. {
  707.   my ($buff, $line_no, $stanza_type) = @_;
  708.   my ($i, $line);
  709.  
  710.   while ($$line_no < (scalar @$buff))
  711.   {
  712.     $_ = $$buff[$$line_no];
  713.     $_ = &Utils::Parse::interfaces_line_clean ($_);
  714.  
  715.     if (/^$stanza_type[ \t]+[^ \t]/)
  716.     {
  717.       s/^$stanza_type[ \t]+//;
  718.       return [ split ("[ \t]+", $_) ];
  719.     }
  720.     $$line_no ++;
  721.   }
  722.  
  723.   return -1;
  724. }
  725.  
  726. sub interfaces_line_is_stanza
  727. {
  728.   my ($line) = @_;
  729.  
  730.   return 1 if $line =~ /^(iface|auto|mapping)[ \t]+[^ \t]/;
  731.   return 0;
  732. }
  733.  
  734. # Scan for next option. An option is something that is
  735. # not a stanza. Return key/value tuple ref, -1 if not found.
  736. # $$line_no will contain position.
  737. sub interfaces_get_next_option
  738. {
  739.   my ($buff, $line_no) = @_;
  740.   my ($i, $line, $empty_lines);
  741.  
  742.   $empty_lines = 0;
  743.   
  744.   while ($$line_no < (scalar @$buff))
  745.   {
  746.     $_ = $$buff[$$line_no];
  747.     $_ = &Utils::Parse::interfaces_line_clean ($_);
  748.  
  749.     if (!/^$/)
  750.     {
  751.       return [ split ("[ \t]+", $_, 2) ] if (! &interfaces_line_is_stanza ($_));
  752.       $$line_no -= $empty_lines;
  753.       return -1;
  754.     }
  755.     else
  756.     {
  757.       $empty_lines ++;
  758.     }
  759.     
  760.     $$line_no ++;
  761.   }
  762.  
  763.   $$line_no -= $empty_lines;
  764.   return -1;
  765. }
  766.  
  767. # Search buffer for option with key $key, starting
  768. # at $$line_no position. Return 1/0 found result.
  769. # $$line_no will show position.
  770. sub interfaces_option_locate
  771. {
  772.   my ($buff, $line_no, $key) = @_;
  773.   my $option;
  774.  
  775.   while (($option = &interfaces_get_next_option ($buff, $line_no)) != -1)
  776.   {
  777.     return 1 if ($$option[0] eq $key);
  778.     $$line_no ++;
  779.   }
  780.   
  781.   return 0;
  782. }
  783.  
  784. # Locate stanza line for $iface in $buff, starting at $$line_no.
  785. sub interfaces_next_stanza_locate
  786. {
  787.   my ($buff, $line_no) = @_;
  788.  
  789.   return &interfaces_get_next_stanza ($buff, \$$line_no, "(iface|auto|mapping)");
  790. }
  791.  
  792. sub interfaces_iface_stanza_locate
  793. {
  794.   my ($buff, $line_no, $iface) = @_;
  795.  
  796.   return &interfaces_generic_stanza_locate ($buff, \$$line_no, $iface, "iface");
  797. }
  798.  
  799. sub interfaces_auto_stanza_locate
  800. {
  801.   my ($buff, $line_no, $iface) = @_;
  802.  
  803.   return &interfaces_generic_stanza_locate ($buff, \$$line_no, $iface, "auto");
  804. }
  805.  
  806. sub interfaces_generic_stanza_locate
  807. {
  808.   my ($buff, $line_no, $iface, $stanza_name) = @_;
  809.   my $stanza;
  810.  
  811.   while (($stanza = &interfaces_get_next_stanza ($buff, \$$line_no, $stanza_name)) != -1)
  812.   {
  813.     return 1 if ($$stanza[0] eq $iface);
  814.     $$line_no++;
  815.   }
  816.  
  817.   return 0;
  818. }
  819.  
  820. # Create a Debian Woody stanza, type auto, with the requested
  821. # @ifaces as values.
  822. sub interfaces_auto_stanza_create
  823. {
  824.   my ($buff, @ifaces) = @_;
  825.   my ($count);
  826.   
  827.   push @$buff, "\n" if ($$buff[$count] ne "");
  828.   push @$buff, "auto " . join (" ", @ifaces) . "\n";
  829. }
  830.  
  831. # Append a stanza for $iface to buffer.
  832. sub interfaces_iface_stanza_create
  833. {
  834.   my ($buff, $iface) = @_;
  835.   my ($count);
  836.  
  837.   $count = $#$buff;
  838.   push @$buff, "\n" if ($$buff[$count] ne "");
  839.   push @$buff, "iface $iface inet static\n";
  840. }
  841.  
  842. # Delete $iface stanza and all its option lines.
  843. sub interfaces_iface_stanza_delete
  844. {
  845.   my ($file, $iface) = @_;
  846.   my ($buff, $line_no, $line_end, $stanza);
  847.  
  848.   $buff = &Utils::File::load_buffer ($file);
  849.   &Utils::File::join_buffer_lines ($buff);
  850.   $line_no = 0;
  851.  
  852.   return -1 if (!&interfaces_iface_stanza_locate ($buff, \$line_no, $iface));
  853.   $line_end = $line_no + 1;
  854.   &interfaces_next_stanza_locate ($buff, \$line_end);
  855.  
  856.   while ($line_no < $line_end)
  857.   {
  858.     delete $$buff[$line_no];
  859.     $line_no++;
  860.   }
  861.   
  862.   $line_no = 0;
  863.   if (&interfaces_auto_stanza_locate ($buff, \$line_no, $iface))
  864.   {
  865.     $line_end = $line_no + 1;
  866.     &interfaces_next_stanza_locate ($buff, \$line_end);
  867.  
  868.     while ($line_no < $line_end)
  869.     {
  870.       delete $$buff[$line_no];
  871.       $line_no++;
  872.     }
  873.   }
  874.   
  875.   &Utils::File::clean_buffer ($buff);
  876.   return &Utils::File::save_buffer ($buff, $file);
  877. }
  878.  
  879. # Find $iface stanza line and replace $pos value (ie the method).
  880. sub set_interfaces_stanza_value
  881. {
  882.   my ($file, $iface, $pos, $value) = @_;
  883.   my ($buff, $line_no, $stanza);
  884.   my ($pre_space, $line, $line_arr);
  885.  
  886.   $buff = &Utils::File::load_buffer ($file);
  887.   &Utils::File::join_buffer_lines ($buff);
  888.   $line_no = 0;
  889.  
  890.   if (!&interfaces_iface_stanza_locate ($buff, \$line_no, $iface))
  891.   {
  892.     $line_no = 0;
  893.     &interfaces_iface_stanza_create ($buff, $iface);
  894.     &interfaces_iface_stanza_locate ($buff, \$line_no, $iface);
  895.   }
  896.  
  897.   $line = $$buff[$line_no];
  898.   chomp $line;
  899.   $pre_space = $1 if $line =~ s/^([ \t]+)//;
  900.   $line =~ s/^iface[ \t]+//;
  901.   @line_arr = split ("[ \t]+", $line);
  902.   $line_arr[$pos] = $value;
  903.   $$buff[$line_no] = $pre_space . "iface " . join (' ', @line_arr) . "\n";
  904.  
  905.   &Utils::File::clean_buffer ($buff);
  906.   return &Utils::File::save_buffer ($buff, $file);
  907. }
  908.  
  909. # Find/append $key option in $iface stanza and set $value.
  910. sub set_interfaces_option_str
  911. {
  912.   my ($file, $iface, $key, $value) = @_;
  913.   my ($buff, $line_no, $stanza, $ret);
  914.   my ($pre_space, $line, $line_arr);
  915.  
  916.   &Utils::Report::enter ();
  917.   &Utils::Report::do_report ("replace_ifaces_str", $key, $iface);
  918.   
  919.   $buff = &Utils::File::load_buffer ($file);
  920.   &Utils::File::join_buffer_lines ($buff);
  921.   $line_no = 0;
  922.  
  923.   if (!&interfaces_iface_stanza_locate ($buff, \$line_no, $iface))
  924.   {
  925.     $line_no = 0;
  926.     &interfaces_iface_stanza_create ($buff, $iface);
  927.     &interfaces_iface_stanza_locate ($buff, \$line_no, $iface);
  928.   }
  929.  
  930.   $line_no++;
  931.  
  932.   if (&interfaces_option_locate ($buff, \$line_no, $key))
  933.   {
  934.     if ($value eq "") # Delete option if value is empty.
  935.     {
  936.       $$buff[$line_no] = "";
  937.     }
  938.     else
  939.     {
  940.       chomp $$buff[$line_no];
  941.       $$buff[$line_no] =~ s/^([ \t]*$key[ \t]).*/$1/;
  942.     }
  943.   }
  944.   elsif ($value ne "")
  945.   {
  946.     $line_no --;
  947.     chomp $$buff[$line_no];
  948.     $$buff[$line_no] =~ s/^([ \t]*)(.*)/$1$2\n$1$key /;
  949.   }
  950.  
  951.   $$buff[$line_no] .= $value . "\n" if $value ne "";
  952.   
  953.   &Utils::File::clean_buffer ($buff);
  954.   $ret = &Utils::File::save_buffer ($buff, $file);
  955.   &Utils::Report::leave ();
  956.   return $ret;
  957. }
  958.  
  959. # $key option is keyword. $value says if it should exist or not.
  960. sub set_interfaces_option_kw
  961. {
  962.   my ($file, $iface, $key, $value) = @_;
  963.  
  964.   return &set_interfaces_option_str ($file, $iface, $key, $value? " ": "");
  965. }
  966.  
  967. # !$value says if keyword should exist or not (ie noauto).
  968. sub set_interfaces_option_kw_not
  969. {
  970.   my ($file, $iface, $key, $value) = @_;
  971.  
  972.   return &set_interfaces_option_kw ($file, $iface, $key, !$value);
  973. }
  974.  
  975.  
  976. # Implementing pump(8) pump.conf file format replacer.
  977. # May be useful for dhcpd too.
  978.  
  979. # Try to find the next option, returning an array ref
  980. # with the found key and the rest of the options in
  981. # two items, or -1 if not found.
  982. sub pump_get_next_option
  983. {
  984.   my ($buff, $line_no) = @_;
  985.  
  986.   while ($$line_no < (scalar @$buff))
  987.   {
  988.     $_ = $$buff[$$line_no];
  989.     $_ = &Utils::Parse::interfaces_line_clean ($_);
  990.     if ($_ ne "")
  991.     {
  992.       return [ split ("[ \t]+", $_, 2) ];
  993.     }
  994.     
  995.     $$line_no ++;
  996.   }
  997.  
  998.   return -1;
  999. }
  1000.  
  1001. # Iterate with get_next_option, starting at $line_no
  1002. # until the option with $key is found, or eof.
  1003. # Return 0/1 as found.
  1004. sub pump_option_locate
  1005. {
  1006.   my ($buff, $line_no, $key) = @_;
  1007.   my ($opt);
  1008.   
  1009.   while (($opt = &pump_get_next_option ($buff, $line_no)) != -1)
  1010.   {
  1011.     return 1 if $$opt[0] eq $key;
  1012.     return 0 if $$opt[0] eq "}";
  1013.  
  1014.     $$line_no ++;
  1015.   }
  1016.   
  1017.   return 0;
  1018. }
  1019.  
  1020. # Try to find a "device" option whose interface is $iface,
  1021. # starting at $$line_no. Return 0/1 as found.
  1022. sub pump_get_device
  1023. {
  1024.   my ($buff, $line_no, $iface) = @_;
  1025.   my ($opt);
  1026.  
  1027.   while (($opt = &pump_get_next_option ($buff, $line_no)) != -1)
  1028.   {
  1029.     if ($$opt[0] eq "device")
  1030.     {
  1031.       $$opt[1] =~ s/[ \t]*\{//;
  1032.       return 1 if $$opt[1] eq $iface;
  1033.     }
  1034.  
  1035.     $$line_no ++;
  1036.   }
  1037.  
  1038.   return 0;
  1039. }
  1040.  
  1041. # Add a device entry for $iface at the end of $buff.
  1042. sub pump_add_device
  1043. {
  1044.   my ($buff, $iface) = @_;
  1045.  
  1046.   push @$buff, "\n";
  1047.   push @$buff, "device $iface {\n";
  1048.   push @$buff, "\t\n";
  1049.   push @$buff, "}\n";
  1050. }
  1051.  
  1052. # Find a "device" section for $iface and
  1053. # replace/add/delete the $key option inside the section.
  1054. sub set_pump_iface_option_str
  1055. {
  1056.   my ($file, $iface, $key, $value) = @_;
  1057.   my ($line_no, $ret);
  1058.  
  1059.   $buff = &Utils::File::load_buffer ($file);
  1060.   $line_no = 0;
  1061.  
  1062.   if (!&pump_get_device ($buff, \$line_no, $iface))
  1063.   {
  1064.     $line_no = 0;
  1065.     &pump_add_device ($buff, $iface);
  1066.     &pump_get_device ($buff, \$line_no, $iface);
  1067.   }
  1068.  
  1069.   $line_no ++;
  1070.  
  1071.   if (&pump_option_locate ($buff, \$line_no, $key))
  1072.   {
  1073.     if ($value eq "")
  1074.     {
  1075.       $$buff[$line_no] = "";
  1076.     }
  1077.     else
  1078.     {
  1079.       chomp $$buff[$line_no];
  1080.       $$buff[$line_no] =~ s/^([ \t]*$key[ \t]).*/$1/;
  1081.     }
  1082.   }
  1083.   elsif ($value ne "")
  1084.   {
  1085.     $line_no --;
  1086.     chomp $$buff[$line_no];
  1087.     $$buff[$line_no] =~ s/^([ \t]*)(.*)/$1$2\n$1$key /;
  1088.   }
  1089.  
  1090.   if ($value ne "")
  1091.   {
  1092.     $value =~ s/^[ \t]+//;
  1093.     $value =~ s/[ \t]+$//;
  1094.     $$buff[$line_no] .= &Utils::Parse::escape ($value) . "\n";
  1095.   }
  1096.  
  1097.   &Utils::File::clean_buffer ($buff);
  1098.   $ret = &Utils::File::save_buffer ($buff, $file);
  1099.   &Utils::Report::leave ();
  1100.   return $ret;
  1101. }
  1102.  
  1103. # Same as function above, except $key is a keyword.
  1104. sub set_pump_iface_kw
  1105. {
  1106.   my ($file, $iface, $key, $value) = @_;
  1107.  
  1108.   return &set_pump_iface_option_str ($file, $iface, $key, $value? " ": "");
  1109. }
  1110.  
  1111. # Same, but use the negative of $value (i.e. nodns)
  1112. sub set_pump_iface_kw_not
  1113. {
  1114.   my ($file, $iface, $key, $value) = @_;
  1115.  
  1116.   return &set_pump_iface_kw ($file, $iface, $key, !$value);
  1117. }
  1118.  
  1119. sub set_xml_pcdata
  1120. {
  1121.   my ($file, $varpath, $data) = @_;
  1122.   my ($model, $branch, $fd, $compressed);
  1123.  
  1124.   ($model, $compressed) = &Utils::XML::model_scan ($file);
  1125.   $branch = &Utils::XML::model_ensure ($model, $varpath);
  1126.  
  1127.   &Utils::XML::model_set_pcdata ($branch, $data);
  1128.  
  1129.   return &Utils::XML::model_save ($model, $file, $compressed);
  1130. }
  1131.  
  1132. sub set_xml_attribute
  1133. {
  1134.   my ($file, $varpath, $attr, $value) = @_;
  1135.   my ($model, $branch, $fd, $compressed);
  1136.  
  1137.   ($model, $compressed) = &Utils::XML::model_scan ($file);
  1138.   $branch = &Utils::XML::model_ensure ($model, $varpath);
  1139.  
  1140.   &Utils::XML::model_set_attribute ($branch, $attr, $value);
  1141.  
  1142.   return &Utils::XML::model_save ($model, $file, $compressed);
  1143. }
  1144.  
  1145. sub set_xml_pcdata_with_type
  1146. {
  1147.   my ($file, $varpath, $type, $data) = @_;
  1148.   my ($model, $branch, $fd, $compressed);
  1149.  
  1150.   ($model, $compressed) = &Utils::XML::model_scan ($file);
  1151.   $branch = &Utils::XML::model_ensure ($model, $varpath);
  1152.  
  1153.   &Utils::XML::model_set_pcdata ($branch, $data);
  1154.   &Utils::XML::model_set_attribute ($branch, "TYPE", $type);
  1155.  
  1156.   return &Utils::XML::model_save ($model, $file, $compressed);
  1157. }
  1158.  
  1159. sub set_xml_attribute_with_type
  1160. {
  1161.   my ($file, $varpath, $attr, $type, $value) = @_;
  1162.   my ($model, $branch, $fd, $compressed);
  1163.  
  1164.   ($model, $compressed) = &Utils::XML::model_scan ($file);
  1165.   $branch = &Utils::XML::model_ensure ($model, $varpath);
  1166.  
  1167.   &Utils::XML::model_set_attribute ($branch, $attr, $value);
  1168.   &Utils::XML::model_set_attribute ($branch, "TYPE", $type);
  1169.  
  1170.   return &Utils::XML::model_save ($model, $file, $compressed);
  1171. }
  1172.  
  1173. sub set_fq_hostname
  1174. {
  1175.   my ($file, $hostname, $domain) = @_;
  1176.  
  1177.   if ($domain eq undef)
  1178.   {
  1179.     return &set_first_line ($file, "$hostname");
  1180.   }
  1181.   else
  1182.   {
  1183.     return &set_first_line ($file, "$hostname.$domain");
  1184.   }
  1185. }
  1186.  
  1187. sub set_rcinet1conf
  1188. {
  1189.   my ($file, $iface, $kw, $val) = @_;
  1190.   my ($line);
  1191.  
  1192.   $iface =~ s/eth//;
  1193.   $line = "$kw\[$iface\]";
  1194.  
  1195.   $val = "\"$val\"";
  1196.  
  1197.   return &split ($file, $line, "[ \t]*=[ \t]*", $val);
  1198. }
  1199.  
  1200. sub set_rcinet1conf_global
  1201. {
  1202.   my ($file, $kw, $val) = @_;
  1203.  
  1204.   $val = "\"$val\"";
  1205.  
  1206.   return &split ($file, $kw, "[ \t]*=[ \t]*", $val)
  1207. }
  1208.  
  1209. # Functions for replacing in FreeBSD's /etc/ppp/ppp.conf
  1210. sub set_pppconf_common
  1211. {
  1212.   my ($pppconf, $section, $key, $string) = @_;
  1213.   my ($buff, $line_no, $end_line_no, $i, $found);
  1214.  
  1215.   $buff = &Utils::File::load_buffer ($pppconf);
  1216.  
  1217.   $line_no = &Utils::Parse::pppconf_find_stanza ($buff, $section);
  1218.  
  1219.   if ($line_no ne -1)
  1220.   {
  1221.     # The stanza exists
  1222.     $line_no++;
  1223.  
  1224.     $end_line_no = &Utils::Parse::pppconf_find_next_stanza ($buff, $line_no);
  1225.     $end_line_no = scalar @$buff + 1 if ($end_line_no == -1);
  1226.     $end_line_no--;
  1227.  
  1228.     for ($i = $line_no; $i <= $end_line_no; $i++)
  1229.     {
  1230.       if ($$buff[$i] =~ /[ \t]+$key/)
  1231.       {
  1232.         if ($string ne undef)
  1233.         {
  1234.           $$buff[$i] = " $string\n";
  1235.           $found = 1;
  1236.         }
  1237.         else
  1238.         {
  1239.           delete $$buff[$i];
  1240.         }
  1241.       }
  1242.     }
  1243.  
  1244.     if ($found != 1)
  1245.     {
  1246.       $$buff[$end_line_no] .= " $string\n" if ($string ne undef);
  1247.     }
  1248.   }
  1249.   else
  1250.   {
  1251.     if ($string ne undef)
  1252.     {
  1253.       push @$buff, "$section:\n";
  1254.       push @$buff, " $string\n";
  1255.     }
  1256.   }
  1257.  
  1258.   &Utils::File::clean_buffer ($buff);
  1259.   return &Utils::File::save_buffer ($buff, $pppconf);
  1260. }
  1261.  
  1262. sub set_pppconf
  1263. {
  1264.   my ($pppconf, $section, $key, $value) = @_;
  1265.   &set_pppconf_common ($pppconf, $section, $key, "set $key $value");
  1266. }
  1267.  
  1268. sub set_pppconf_bool
  1269. {
  1270.   my ($pppconf, $section, $key, $value) = @_;
  1271.   &set_pppconf_common ($pppconf, $section, $key,
  1272.                        ($value == 1)? "enable $key" : "disable $key");
  1273. }
  1274.  
  1275. sub set_ppp_options_re
  1276. {
  1277.   my ($file, $re, $value) = @_;
  1278.   my ($buff, $line, $replaced, $ret);
  1279.   my ($pre_space, $post_comment);
  1280.  
  1281.   &Utils::Report::enter ();
  1282.   &Utils::Report::do_report ("network_set_ppp_option", &Utils::Replace::regexp_to_separator ($re), $file);
  1283.  
  1284.   $buff = &Utils::File::load_buffer ($file);
  1285.  
  1286.   foreach $line (@$buff)
  1287.   {
  1288.     $pre_space = $post_comment = "";
  1289.     chomp $line;
  1290.     $pre_space = $1 if $line =~ s/^([ \t]+)//;
  1291.     $post_comment = $1 if $line =~ s/([ \t]*\#.*)//;
  1292.     
  1293.     if ($line =~ /$re/)
  1294.     {
  1295.       $line = "$value\n";
  1296.       $replaced = 1;
  1297.       last;
  1298.     }
  1299.  
  1300.     $line = $pre_space . $line . $post_comment . "\n";
  1301.   }
  1302.  
  1303.   push @$buff, "$value\n" if !$replaced;
  1304.   
  1305.   &Utils::File::clean_buffer ($buff);
  1306.   $ret = &Utils::File::save_buffer ($buff, $file);
  1307.   &Utils::Report::leave ();
  1308.   return $ret;
  1309. }
  1310.  
  1311. sub set_ppp_options_connect
  1312. {
  1313.   my ($file, $value) = @_;
  1314.   my $ret;
  1315.  
  1316.   &Utils::Report::enter ();
  1317.   &Utils::Report::do_report ("network_set_ppp_connect", $file);
  1318.   $ret = &set_ppp_options_re ($file, "^connect", "connect \"/usr/sbin/chat -v -f /etc/chatscripts/$value\"");
  1319.   &Utils::Report::leave ();
  1320.   return $ret;
  1321. }
  1322.  
  1323. sub set_confd_net_re
  1324. {
  1325.   my ($file, $key, $re, $value) = @_;
  1326.   my ($str, $contents, $i, $found, $done);
  1327.  
  1328.   $found = $done = 0;
  1329.   $contents = &Utils::File::load_buffer ($file);
  1330.  
  1331.   for ($i = 0; $i <= scalar (@$contents); $i++)
  1332.   {
  1333.     # search for key
  1334.     if ($$contents[$i] =~ /^$key[ \t]*=[ \t]*\(/)
  1335.     {
  1336.       $found = 1;
  1337.  
  1338.       do {
  1339.         if ($$contents[$i] =~ /\"([^\"]*)\"/)
  1340.         {
  1341.           $str = $1;
  1342.  
  1343.           if ($str =~ /$re/)
  1344.           {
  1345.             $str =~ s/$re/$value/;
  1346.           }
  1347.           else
  1348.           {
  1349.             $str .= $value;
  1350.           }
  1351.  
  1352.           $$contents[$i] =~ s/\"([^\"]*)\"/\"$str\"/;
  1353.           $done = 1;
  1354.         }
  1355.  
  1356.         $i++;
  1357.       } while (!$done);
  1358.     }
  1359.   }
  1360.  
  1361.   if (!$found)
  1362.   {
  1363.     push @$contents, "$key=(\"$value\")\n";
  1364.   }
  1365.  
  1366.   return &Utils::File::save_buffer ($contents, $file);
  1367. }
  1368.  
  1369. sub set_confd_net
  1370. {
  1371.   my ($file, $key, $value) = @_;
  1372.  
  1373.   return &set_confd_net_re ($file, $key, ".*", $value);
  1374. }
  1375.  
  1376.  
  1377. 1;
  1378.